home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / utility / sml-mode-3.3b / sml-hilite.el < prev    next >
Encoding:
Text File  |  1997-08-18  |  4.9 KB  |  139 lines  |  [TEXT/R*ch]
  1. ;;; sml-hilite.el. Highlighting for sml-mode using hilit19.
  2.  
  3. ;; Copyright (C) 1995 Frederick Knabe
  4. ;;
  5. ;; Author:     Fritz Knabe <knabe@ecrc.de>
  6. ;;             ECRC GmbH, Arabellastr. 17, 81925 Munich, Germany
  7. ;;
  8. ;; Created:    08-Nov-94, Fritz Knabe <knabe@ecrc.de>
  9. ;; Modified:   14-Apr-97, M.J.Morley <mjm@scs.leeds.ac.uk>
  10. ;;             Added a few keywords to hilit-set-mode-patters.
  11.  
  12. ;; This file is not part of GNU Emacs, but it is distributed under the
  13. ;; same conditions.
  14.  
  15. ;; ====================================================================
  16.  
  17. ;; This program is free software; you can redistribute it and/or
  18. ;; modify it under the terms of the GNU General Public License as
  19. ;; published by the Free Software Foundation; either version 2, or (at
  20. ;; your option) any later version.
  21.  
  22. ;; This program is distributed in the hope that it will be useful, but
  23. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  24. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  25. ;; General Public License for more details.
  26.  
  27. ;; You should have received a copy of the GNU General Public License
  28. ;; along with GNU Emacs; see the file COPYING. If not, write to the
  29. ;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  30.  
  31. ;; ====================================================================
  32.  
  33. ;; Put this code *after* the (require 'hilit19) in your .emacs.
  34. ;; Alternatively, put it in an (eval-after-load "hilit19" ...).
  35.  
  36. ;; Better, use sml-load-hook like this:
  37.  
  38. ;; (setq sml-load-hook
  39. ;;       '(lambda() "Highlights." (require 'sml-hilite)))
  40.  
  41. ;; hilit19 does not currently appear to belong to XEmacs -- they
  42. ;; favour `font-lock'. Font-lock patterns in sml-font.el
  43.  
  44. ;;; CODE
  45.  
  46. (require 'hilit19)
  47.  
  48. (cond ((and (x-display-color-p) (eq hilit-background-mode 'light))
  49.        ;; for SML
  50.        (hilit-translate sml-comment    'firebrick-italic)
  51.        (hilit-translate sml-string    'ForestGreen-italic)
  52.        (hilit-translate sml-keyword    'blue-bold))
  53.       ((and (x-display-color-p) (eq hilit-background-mode 'dark))
  54.        ;; for SML
  55.        (hilit-translate sml-comment    'moccasin-italic)
  56.        (hilit-translate sml-string    'green-italic)
  57.        (hilit-translate sml-keyword    'cyan-bold))
  58.       (t
  59.        ;; for SML
  60.        (hilit-translate sml-comment    'default-italic)
  61.        (hilit-translate sml-string    'default-bold-italic)
  62.        (hilit-translate sml-keyword    'default-bold)))
  63.  
  64. (hilit-set-mode-patterns
  65.  'sml-mode
  66.  '((kn-hilit-sml-string-find "" sml-string)
  67.    (kn-hilit-sml-comment-find "" sml-comment)
  68.    ;; The old patterns
  69.    ;;("\"" "[^\\]\"" sml-string)
  70.    ;;("(\\*" "\\*)" sml-comment)
  71.    ("\\(\\`\\|[^_']\\)\
  72. \\<\\(\
  73. a\\(bstype\\|nd\\(\\|also\\)\\|s\\)\\|case\\|d\\(atatype\\|o\\)\\|\
  74. e\\(lse\\|nd\\|qtype\\|xception\\)\\|f\\(n\\|un\\(\\|ctor\\)\\)\\|\handle\\|\
  75. i\\([fn]\\|n\\(clude\\|fixr?\\)\\)\\|l\\(et\\|ocal\\)\\|nonfix\\|\
  76. o\\([fp]\\|pen\\|relse\\|verload\\)\\|r\\(aise\\|ec\\)\\|\
  77. s\\(haring\\|ig\\(\\|nature\\)\\|truct\\(\\|ure\\)\\)\\|t\\(hen\\|ype\\)\\|\
  78. val\\|w\\(h\\(ere\\|ile\\)\\|ith\\(\\|type\\)\\)
  79. \\)\\>\
  80. \\(\\'\\|[^_']\\)" 2 sml-keyword)))
  81.  
  82. (defun kn-hilit-sml-string-find (dummy)
  83.   "Find an SML string and return (START . END); if none, returns nil. 
  84. Skips over potentially nested comments when searching for the start of the
  85. string. Skips over \f...f\ (where f is whitespace) sequences in strings."
  86.   (let ((nest 0)
  87.     (continue t)
  88.     st en)
  89.     (while (and continue
  90.         (re-search-forward "\\(\"\\)\\|\\((\\*\\)\\|\\(\\*)\\)" nil t))
  91.       (cond
  92.        ((match-beginning 1) (setq continue (> nest 0)))
  93.        ((match-beginning 2) (setq nest (+ nest 1)))
  94.        ((match-beginning 3) (setq nest (- nest 1)))))
  95.     (if (not continue)
  96.     (progn
  97.       (setq st (match-beginning 1))
  98.       (while (and (re-search-forward
  99.                "\\(\"\\)\\|\\(\\\\\\s-*\\\\\\)\\|\\(\\\\\"\\)" nil t)
  100.               (cond
  101.                ((match-beginning 1) (setq en (point)) nil)
  102.                ((match-beginning 2) t)
  103.                ((match-beginning 3) t))))
  104.       (and en (cons st en))))))
  105.  
  106. (defun kn-hilit-sml-comment-find (dummy)
  107.   "Find an SML comment and return (START . END); if none, returns nil.
  108. Handles nested comments. Ensures that the comment starts outside of a string."
  109.   (let ((continue t)
  110.     (nest 1)
  111.     st en)
  112.     (while (and continue
  113.         (re-search-forward "\\(\"\\)\\|\\((\\*\\)" nil t))
  114.       (cond
  115.        ((match-beginning 1)
  116.     (while (and (re-search-forward
  117.              "\\(\"\\)\\|\\(\\\\\\s-*\\\\\\)\\|\\(\\\\\"\\)" nil t)
  118.             (cond
  119.              ((match-beginning 1) nil)
  120.              ((match-beginning 2) t)
  121.              ((match-beginning 3) t)))))
  122.        ((match-beginning 2) (setq continue nil))))
  123.     (if (not continue)
  124.     (progn
  125.       (setq st (match-beginning 2))
  126.       (setq continue t)
  127.       (while (and continue
  128.               (re-search-forward "\\((\\*\\)\\|\\(\\*)\\)" nil t))
  129.         (cond
  130.          ((match-beginning 1) (setq nest (+ nest 1)))
  131.          ((match-beginning 2)
  132.           (setq nest (- nest 1)) (setq continue (> nest 0)))))
  133.       (if (not continue)
  134.           (cons st (match-end 2)))))))
  135.  
  136. (provide 'sml-hilite)
  137.  
  138. ;;; no more sml-hilite.el, it's finished.
  139.